Introduction

Brief summary

Sparse canonical correlation analysis for neuroimaging (SCCAN) is a general purpose tool for “two-sided” multiple regression. This allows one to symmetrically compare one matrix of data to another and find linear relationships between them in a low-dimensional space. SCCAN derives from classic canonical correlation analysis and also relates to singular value decomposition. To handle data with \(p>>n\), SCCAN uses high-dimensional regularization methods common in \(\ell_1\) regression and spatial regularization to help ensure the biological plausibility of statistical maps in medical imaging. This problem is a difficult optimization (\(np\)-hard) and, to improve solution interpetability and stability, SCCAN allows one to to use prior knowledge to constrain the solution space.

Examples

Perhaps the best way to understand how to use SCCAN is by running example data.

Read example data

We read in some neuroimaging and cognitive data below.

data(aal,package='ANTsR')
gfnl<-list.files(path=rootdir, pattern = glob2rx("pbac*mha"),
  full.names = T,recursive = T)
ptrainimg<-as.matrix(antsImageRead(gfnl[2],2))
ptestimg<-as.matrix(antsImageRead(gfnl[1],2))
gfnl<-list.files(path=rootdir, pattern = "gmask.nii.gz",
  full.names = T,recursive = T)
mask<-antsImageRead( gfnl[1], 3 )
afnl<-list.files(path=rootdir, pattern = "aal.nii.gz",
  full.names = T,recursive = T)
aalimg<-antsImageRead( afnl[1], 3 )
f1<-list.files(path =rootdir, pattern = "pbac_train_cog.csv",
  recursive=TRUE, full.names = TRUE, include.dirs=TRUE )
f2<-list.files(path = rootdir, pattern = "pbac_test_cog.csv",
  recursive=TRUE, full.names = TRUE )
ptraincog<-read.csv(f1)
ptestcog<-read.csv(f2)

We already divided the dataset into two different groups - one for testing and one for training.

Sparse regression

Use sccan to find brain regions relating to age. We impose a “cluster threshold” regularization to prevent isolated voxels from appearing in the solution. We will also compare the results in training with that in testing as a function of spareseness.

agemat<-matrix( ptraincog$age, ncol=1)
paramsearch<-c(1:10)/(-100.0)
paramsearchcorrs<-rep(0,length(paramsearch))
paramsearchpreds<-rep(0,length(paramsearch))
ct<-1
for ( sp in paramsearch ) {
  ageresult<-sparseDecom2( inmatrix=list(ptrainimg,agemat), its=8, mycoption=1,
    sparseness=c(sp,0.9), inmask=c(mask,NA),nvecs=2, cthresh=c(50,0))
  # convert output images to matrix so we can validate in test data
  ccamat<-imageListToMatrix( ageresult$eig1, mask )
  agepred<-ptrainimg %*% t(ccamat)
  paramsearchcorrs[ct]<-cor( agepred[,1],  ptraincog$age )
  agepred<-ptestimg %*% t(ccamat)
  paramsearchpreds[ct]<-cor( agepred[,1],  ptestcog$age )
  ct<-ct+1
  }
mydf<-data.frame( sparseness=paramsearch, trainCorrs=paramsearchcorrs,
  testCorrs=paramsearchpreds )
mdl1<-lm( trainCorrs ~ stats::poly(sparseness,4), data=mydf )
mdl2<-lm( testCorrs ~ stats::poly(sparseness,4) , data=mydf )
visreg(mdl1)

plot of chunk sparreg

visreg(mdl2)

plot of chunk sparreg

SCCAN with prior initialization

Use SCCAN to find brain regions relating to language. We initialize with left hemisphere regions.

langmat<-cbind(  ptraincog$speech_adj, ptraincog$writing_adj,
                 ptraincog$semantic_adj, ptraincog$reading_adj,
                 ptraincog$naming_adj )
colnames(langmat)<-c("speech","writing","semantic","reading","naming")
langmat2<-cbind( ptestcog$speech_adj, ptestcog$writing_adj,
                 ptestcog$semantic_adj, ptestcog$reading_adj,
                 ptestcog$naming_adj )
colnames(langmat2)<-colnames(langmat)
labels<-c(13,81,39,79)
print(aal$label_name[labels])
## [1] Frontal_Inf_Tri_L Temporal_Sup_L    ParaHippocampal_L Heschl_L         
## 116 Levels: Amygdala_L Amygdala_R Angular_L Angular_R ... Vermis_9
initmat<-matrix( rep(0,sum(mask==1)*length(labels)), nrow=length(labels) )
# fill the matrix with the aal region locations
for ( i in 1:length(labels) ) {
  vec<-( aalimg[ mask == 1 ] == labels[i] )
  vec[ vec > 0]<-vec[ vec > 0]+rnorm(sum(vec>0))*0.01
  initmat[i,]<-vec
}
ccainit<-initializeEigenanatomy( initmat, mask )
pwsearch<-c(50,25,10)
langfn<-rep("",length(pwsearch))
langfn2<-rep("",length(pwsearch))
ct<-1
for ( pw in pwsearch ) {
langresult<-sparseDecom2( inmatrix=list(ptrainimg,langmat), its=15, mycoption=1,
  sparseness=c(sp,-0.3), inmask=c(mask,NA),nvecs=length(labels), cthresh=c(125,0),
  initializationList=ccainit$initlist, priorWeight=pw/100, smooth=0.0, ell1=-10 )
ccamat<-imageListToMatrix( langresult$eig1, mask )
langpred<-ptrainimg %*% t(ccamat)
colnames(langpred)<-paste("GM",c(1:ncol(langpred)),sep='')
cogpred<-langmat %*% data.matrix( langresult$eig2 )
bestpred<-which.max(abs(diag(cor(langpred,cogpred))))
mydf<-data.frame( cogpred, langpred )
myform<-as.formula( paste("Variate00",bestpred-1,"~GM1+GM2+GM3+GM4",sep='') )
mdltrain<-lm( myform, data=mydf )
langpred<-ptestimg %*% t(ccamat)
colnames(langpred)<-paste("GM",c(1:ncol(langpred)),sep='')
cogpred<-langmat2 %*% data.matrix( langresult$eig2 )
mydf<-data.frame( cogpred, langpred )
print(cor.test( mydf[,bestpred] ,predict(mdltrain,newdata=mydf)))
for ( i in 1:length(labels) )
  print( paste( "Dice: ",aal$label_name[labels[i]],
         sum( abs(ccamat[i,]) > 0 & initmat[i,] > 0 ) /
         sum( abs(ccamat[i,]) > 0 | initmat[i,] > 0 ) ) )
for ( x in langresult$eig1 ) {
  x[ mask == 1 ]<-abs( x[ mask == 1 ] )
  x[ mask == 1 ]<-x[ mask == 1 ]/max( x[ mask == 1 ] )
}
mycolors<-c("red","green","blue","yellow")
langfn[ct]<-paste(rootdir,'/figures/langSCCANRegression',pw,'.jpg',sep='')
langfn2[ct]<-paste(rootdir,'/figures/langSCCANRegression',pw,'.png',sep='')
plotANTsImage( mask, functional=(langresult$eig1), threshold='0.25x1',
  slices="12x50x1",color=mycolors,outname=langfn[ct] )
# cnt<-getCentroids( ntwkimage, clustparam = 100 )
brain<-renderSurfaceFunction( surfimg =list( aalimg ) , alphasurf=0.1 ,
  funcimg=langresult$eig1, smoothsval=1.5, smoothfval=0, mycol=mycolors )
id<-par3d("userMatrix")
rid<-rotate3d( id , -pi/2, 1, 0, 0 )
rid2<-rotate3d( id , pi/2, 0, 0, 1 )
rid3<-rotate3d( id , -pi/2, 0, 0, 1 )
par3d(userMatrix = id )
dd<-make3ViewPNG(  rid, id, rid2, paste(rootdir,'/figures/langSCCANRegression',pw,sep='') )
par3d(userMatrix = id )
ct<-ct+1
}
## 
##  Pearson's product-moment correlation
## 
## data:  mydf[, bestpred] and predict(mdltrain, newdata = mydf)
## t = 2.687, df = 81, p-value = 0.008751
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.0750 0.4726
## sample estimates:
##    cor 
## 0.2861 
## 
## [1] "Dice:  Frontal_Inf_Tri_L 0.997280761386812"
## [1] "Dice:  Temporal_Sup_L 0.989698307579102"
## [1] "Dice:  ParaHippocampal_L 1"
## [1] "Dice:  Heschl_L 0"
## Warning: the condition has length > 1 and only the first element will be used
## Warning: 'x' is NULL so the result will be NULL
## Warning: the condition has length > 1 and only the first element will be used
## 
##  Pearson's product-moment correlation
## 
## data:  mydf[, bestpred] and predict(mdltrain, newdata = mydf)
## t = 4.968, df = 81, p-value = 3.704e-06
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.2987 0.6330
## sample estimates:
##    cor 
## 0.4832 
## 
## [1] "Dice:  Frontal_Inf_Tri_L 0.174365376612568"
## [1] "Dice:  Temporal_Sup_L 0.973509933774834"
## [1] "Dice:  ParaHippocampal_L 0.940677966101695"
## [1] "Dice:  Heschl_L 0.437956204379562"
## Warning: the condition has length > 1 and only the first element will be used
## Warning: 'x' is NULL so the result will be NULL
## Warning: the condition has length > 1 and only the first element will be used
## 
##  Pearson's product-moment correlation
## 
## data:  mydf[, bestpred] and predict(mdltrain, newdata = mydf)
## t = 5.685, df = 81, p-value = 2.001e-07
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.3598 0.6723
## sample estimates:
##   cor 
## 0.534 
## 
## [1] "Dice:  Frontal_Inf_Tri_L 0.0787226141849239"
## [1] "Dice:  Temporal_Sup_L 0"
## [1] "Dice:  ParaHippocampal_L 0.110299488677867"
## [1] "Dice:  Heschl_L 0"
## Warning: the condition has length > 1 and only the first element will be used
## Warning: 'x' is NULL so the result will be NULL
## Warning: the condition has length > 1 and only the first element will be used

Strong prior

Strong prior

Strong prior 3D

Medium prior

Medium prior

Medium prior 3D

Weak prior

Weak prior

Weak prior 3D

Identifying the anatomical network

The best results are initialized by the prior but, in the end, drift away from that initialization. Where in the brain do the solution vectors end up?

reportAnatomy<-function( eigIn, maskIn, wt=0.3 )
  {
  data('aal',package='ANTsR')
  ccaanat<-list()
  for ( img in eigIn ) {
    nzind<-abs(img[ maskIn == 1 ]) > 0
    aalvals<-aalimg[ maskIn == 1 ][ nzind ]
    ccaanat<-lappend( ccaanat, aalvals )
  }
  ccaanat<-unlist( ccaanat )
  anatcount<-hist(ccaanat,breaks=0:100, plot = F)$count
  anatcount[ anatcount < wt*max(anatcount) ]<-0
  anatcount<-which( anatcount > 0 )
  return( toString(aal$label_name[anatcount] ) )
  }
ccaaal<-reportAnatomy( langresult$eig1 , mask )

The SCCAN predictors include: Frontal_Inf_Tri_L, Precuneus_R, Temporal_Sup_R, Temporal_Mid_R, Temporal_Inf_R.

How good were our original hypothetical regions as predictors?

Associating classes to SCCAN predictors

Recalling: CCA maximizes \(PearsonCorrelation( XW^T, ZY^T )\), we can study matrix \(Y\) which contrasts or combines columns of the cognition/design matrix.

rownames(langresult$eig2)<-colnames(langmat)
temp<-(langresult$eig2)
temp[ abs(langresult$eig2) < 0.03 ]<-0
pheatmap(temp)

plot of chunk sccanpredictorclass2

Sparse regression with nuisance variables

Often, we want to control for the presence of nuisance variables. As usual, there are several options: (1) control after you do dimensionality reduction; (2) orthogonalize the predictors. (3) Use alternative SCCAN formulations (e.g. set mycoption to 0 or 2). Let’s try the first 2 choices as they are more traditional.

# 1. control for age and mmse after the dimensionality reduction
langresult<-sparseDecom2( inmatrix=list(ptrainimg,langmat), its=15, mycoption=1,
  sparseness=c(sp,-0.9), inmask=c(mask,NA),nvecs=length(labels), cthresh=c(50,0),
  initializationList=ccainit$initlist, priorWeight=pw/100, smooth=0.0, ell1=-10 )
ccamat<-imageListToMatrix( langresult$eig1, mask )
langpred<-ptrainimg %*% t(ccamat)
colnames(langpred)<-paste("GM",c(1:ncol(langpred)),sep='')
cogpred<-langmat %*% data.matrix( langresult$eig2 )
bestpred<-which.max(abs(diag(cor(langpred,cogpred))))
mydf<-data.frame( cogpred, langpred, mmse=ptraincog$mmse,age=ptraincog$age)
myform<-as.formula( paste("Variate00",bestpred-1,
  "~GM1+GM2+GM3+GM4+mmse+age",sep='') )
mdltrain<-lm( myform, data=mydf )
print(summary(mdltrain))
## 
## Call:
## lm(formula = myform, data = mydf)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -0.2665 -0.0329  0.0149  0.0546  0.1134 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -6.01e-01   2.26e-01   -2.66   0.0094 ** 
## GM1         -3.23e+00   5.60e+00   -0.58   0.5660    
## GM2         -1.57e+01   7.20e+00   -2.19   0.0315 *  
## GM3         -1.28e+00   2.12e+00   -0.61   0.5455    
## GM4         -4.91e+00   2.62e+00   -1.87   0.0645 .  
## mmse         7.14e-03   1.52e-03    4.71    1e-05 ***
## age         -2.35e-04   1.19e-03   -0.20   0.8439    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.0835 on 82 degrees of freedom
## Multiple R-squared:  0.59,   Adjusted R-squared:  0.559 
## F-statistic: 19.6 on 6 and 82 DF,  p-value: 4.53e-14
langpred2<-ptestimg %*% t(ccamat)
colnames(langpred2)<-paste("GM",c(1:ncol(langpred)),sep='')
cogpred2<-langmat2 %*% data.matrix( langresult$eig2 )
mydf<-data.frame( cogpred2, langpred2,mmse=ptestcog$mmse,age=ptestcog$age )
print(cor.test( mydf[,bestpred] ,predict(mdltrain,newdata=mydf)))
## 
##  Pearson's product-moment correlation
## 
## data:  mydf[, bestpred] and predict(mdltrain, newdata = mydf)
## t = 7.338, df = 81, p-value = 1.491e-10
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.4819 0.7459
## sample estimates:
##    cor 
## 0.6319

Now, the second option.

# 2. orthogonalize the matrices against mmse and education
rlangmat<-residuals(lm(langmat~ptraincog$mmse+ptraincog$age))
rptrainimg<-residuals(lm(ptrainimg~ptraincog$mmse+ptraincog$age))
langresult<-sparseDecom2( inmatrix=list(rptrainimg,rlangmat), its=15, mycoption=1,
  sparseness=c(sp,-0.9), inmask=c(mask,NA),nvecs=length(labels), cthresh=c(50,0),
  initializationList=ccainit$initlist, priorWeight=pw/100, smooth=0.0, ell1=-10 )
ccamat<-imageListToMatrix( langresult$eig1, mask )
langpred<-ptrainimg %*% t(ccamat)
colnames(langpred)<-paste("GM",c(1:ncol(langpred)),sep='')
cogpred<-langmat %*% data.matrix( langresult$eig2 )
bestpred<-which.max(abs(diag(cor(langpred,cogpred))))
mydf<-data.frame( cogpred, langpred, mmse=ptraincog$mmse,age=ptraincog$age)
myform<-as.formula( paste("Variate00",bestpred-1,
  "~GM1+GM2+GM3+GM4+mmse+age",sep='') )
mdltrain<-lm( myform, data=mydf )
print(summary(mdltrain))
## 
## Call:
## lm(formula = myform, data = mydf)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -0.2469 -0.0718  0.0067  0.0618  0.1984 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -1.23981    0.17125   -7.24  2.2e-10 ***
## GM1          1.59695    1.40223    1.14    0.258    
## GM2         18.30504    2.57894    7.10  4.1e-10 ***
## GM3         -3.43770    1.68915   -2.04    0.045 *  
## GM4          1.46179    1.91991    0.76    0.449    
## mmse         0.00954    0.00120    7.92  1.0e-11 ***
## age          0.00210    0.00110    1.91    0.060 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.0825 on 82 degrees of freedom
## Multiple R-squared:  0.731,  Adjusted R-squared:  0.711 
## F-statistic: 37.1 on 6 and 82 DF,  p-value: <2e-16
langpred2<-ptestimg %*% t(ccamat)
colnames(langpred2)<-paste("GM",c(1:ncol(langpred)),sep='')
cogpred2<-langmat2 %*% data.matrix( langresult$eig2 )
mydf<-data.frame( cogpred2, langpred2,mmse=ptestcog$mmse,age=ptestcog$age )
print(cor.test( mydf[,bestpred] ,predict(mdltrain,newdata=mydf)))
## 
##  Pearson's product-moment correlation
## 
## data:  mydf[, bestpred] and predict(mdltrain, newdata = mydf)
## t = 7.599, df = 81, p-value = 4.601e-11
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.4989 0.7557
## sample estimates:
##    cor 
## 0.6451

Predicting the full cognitive battery from the neuroimaging data

Try to predict all the demographic variability from the imaging data. We use mycoption 0 to try to reduce correlation in low-dimensional space. This enforces a new SCCAN constraint (not previously reported).

nv<-11
nfn<-rep("",nv)
cognames<-rep("",nv)
cogmat<-data.matrix(ptraincog)
rcogmat<-residuals( lm( data.matrix(ptraincog) ~ ptraincog$mmse + ptraincog$age ) )
rptrainimg<-residuals( lm( ptrainimg ~ ptraincog$mmse ) )
batt<-sparseDecom2( inmatrix=list(rptrainimg,rcogmat), its=15,
  sparseness=c(0.02, -0.05), inmask=c(mask,NA), nvecs=nv, cthresh=c(100,0),
  smooth=0.0, ell1=-10, mycoption=1 )
ccamat<-imageListToMatrix( batt$eig1, mask )
gvars<-paste("GM",c(1:nrow(ccamat)),sep='',collapse='+')

Now let’s use our previously developed reporting capabilities.

render<-TRUE
for ( bestpred in 1:nrow(ccamat)) {
  battpred<-ptrainimg %*% t(ccamat)
  colnames(battpred)<-paste("GM",c(1:ncol(battpred)),sep='')
  cogpred<-( rcogmat %*% data.matrix( batt$eig2 ) )[,bestpred]
  mydf<-data.frame( cogpred, battpred )
  myform<-as.formula( paste("cogpred~",gvars,sep='') )
  mdltrain<-lm( myform, data=mydf )
  mdlinterp<-bigLMStats( mdltrain )
  battpred<-ptestimg %*% t(ccamat)
  colnames(battpred)<-paste("GM",c(1:ncol(battpred)),sep='')
  cogpred<-(data.matrix(ptestcog) %*% data.matrix( batt$eig2 ))[,bestpred]
  mydf<-data.frame( cogpred, battpred )
  cat(paste("Eig",bestpred,"is related to:\n"))
  mycog<-colnames(ptraincog)[ abs(batt$eig2[,bestpred]) > 0 ]
  cat( mycog )
  cat("\nwith weights\n")
  cat( abs(batt$eig2[,bestpred])[ abs(batt$eig2[,bestpred]) > 0 ])
  cat(paste("\nwith predictive correlation:",
    cor( cogpred,predict(mdltrain,newdata=mydf))))
  cat("\nAnatomy:")
  for ( x in which.min(p.adjust(mdlinterp$beta.pval)) )  {
    myanat<-reportAnatomy( list( batt$eig1[[x]]) , mask , 0.5 )
    cat(myanat)
    if ( render ) {
    vizimg<-antsImageClone( batt$eig1[[x]] )
    ImageMath(3,vizimg,'abs',vizimg)
    brain<-renderSurfaceFunction( surfimg =list( aalimg ) , alphasurf=0.1 ,
      funcimg=list(vizimg), smoothsval = 1.5 )
    id<-par3d("userMatrix")
    rid<-rotate3d(  id , -pi/2, 1, 0, 0 )
    rid2<-rotate3d( id ,  pi/2, 0, 0, 1 )
    rid3<-rotate3d( id , -pi/2, 0, 0, 1 )
    par3d(userMatrix = id )
    ofn<-paste(rootdir,'/figures/battery',bestpred,sep='')
    nfn[ bestpred ]<-paste(ofn,'.png',sep='')
    cognames[ bestpred ]<-paste(mycog,collapse='+')
    dd<-make3ViewPNG(  rid, id, rid2, ofn )
    par3d(userMatrix = id )
    }
    cat("\n")
  }
  cat("\n")
}
## Eig 1 is related to:
## fluency_adj JOLO_adj
## with weights
## 0.03572 0.1018
## with predictive correlation: 0.140354896318403
## Anatomy:Frontal_Mid_R, Cingulum_Mid_R, Occipital_Mid_L, Temporal_Mid_L
## 
## Eig 2 is related to:
## naming_adj
## with weights
## 0.1066
## with predictive correlation: 0.468017964104961
## Anatomy:Fusiform_R, Temporal_Inf_R
## 
## Eig 3 is related to:
## rey_copy_adj
## with weights
## 0.1066
## with predictive correlation: 0.397046334604034
## Anatomy:Occipital_Mid_L, Fusiform_L, Parietal_Inf_L, Temporal_Mid_L, Temporal_Inf_L
## 
## Eig 4 is related to:
## recog_adj
## with weights
## 0.1066
## with predictive correlation: 0.128152873945102
## Anatomy:Precentral_L, ParaHippocampal_L, ParaHippocampal_R, Temporal_Mid_L, Temporal_Inf_L
## 
## Eig 5 is related to:
## socialcomportment
## with weights
## 0.1066
## with predictive correlation: 0.266423882213593
## Anatomy:Rectus_L, Rectus_R, Insula_R, Caudate_L, Caudate_R, Putamen_L, Temporal_Inf_L
## 
## Eig 6 is related to:
## rey_recall_adj
## with weights
## 0.1066
## with predictive correlation: 0.170953680680854
## Anatomy:Frontal_Mid_L, Frontal_Mid_R, Insula_L, ParaHippocampal_R, Calcarine_R, Occipital_Mid_L, Fusiform_L, Temporal_Sup_L, Temporal_Mid_L
## 
## Eig 7 is related to:
## speech_adj
## with weights
## 0.1066
## with predictive correlation: -0.103862207243451
## Anatomy:Frontal_Mid_Orb_R, Frontal_Inf_Tri_R, Frontal_Inf_Orb_R, Temporal_Mid_R
## 
## Eig 8 is related to:
## fluency_adj
## with weights
## 0.1066
## with predictive correlation: 0.00347449131443053
## Anatomy:Cuneus_R, Occipital_Sup_R, Occipital_Mid_R, Precuneus_R
## 
## Eig 9 is related to:
## apathy
## with weights
## 0.1066
## with predictive correlation: 0.39854430328004
## Anatomy:Temporal_Sup_R
## 
## Eig 10 is related to:
## delay_free_adj
## with weights
## 0.1066
## with predictive correlation: -0.0795914746536028
## Anatomy:Frontal_Mid_R, Cingulum_Mid_R, Occipital_Mid_L, Temporal_Mid_L
## 
## Eig 11 is related to:
## rey_copy_adj
## with weights
## 0.1066
## with predictive correlation: 0.397046334604034
## Anatomy:Occipital_Mid_L, Fusiform_L, Parietal_Inf_L, Temporal_Mid_L, Temporal_Inf_L

Anatomy related with fluency_adj+JOLO_adj

Select results

Anatomy related with naming_adj

Select results

Anatomy related with rey_copy_adj

Select results

Anatomy related with recog_adj

Select results

Anatomy related with socialcomportment

Select results

Anatomy related with rey_recall_adj

Select results

Anatomy related with speech_adj

Select results

Anatomy related with fluency_adj

Select results

Anatomy related with apathy

Select results

Anatomy related with delay_free_adj

Select results

Anatomy related with rey_copy_adj

Select results

Can the neuroimaging data predict the full cognitive battery?

# use cca to transform cortical signal to the cognitive battery
batt2<-sparseDecom2( inmatrix=list(rptrainimg,rcogmat), its=15,
  sparseness=c(0.02, -0.9), inmask=c(mask,NA), nvecs=nv, cthresh=c(100,0),
  smooth=0.0, ell1=-10, mycoption=1 )
ccamat<-imageListToMatrix( batt2$eig1, mask )
predictedBattery<-data.frame( vox=ptrainimg %*% t(ccamat) %*% t(batt2$eig2) )
print(diag(cor(cogmat,predictedBattery)))
##  [1] 0.04707 0.18585 0.12448 0.08079 0.05763 0.01225 0.51996 0.44400
##  [9] 0.46830 0.38188 0.39129 0.48106 0.37810 0.52096 0.50097 0.10328
## [17] 0.39308 0.42130 0.43802 0.19642 0.32807
predictedBattery<-data.frame( vox=ptestimg %*% t(ccamat) %*% t(batt2$eig2) )
print(diag(cor(data.matrix(ptestcog),predictedBattery)))
##  [1] -0.22095  0.07252 -0.04368 -0.10955 -0.01810 -0.04819  0.39080
##  [8]  0.08382  0.14221  0.08864  0.36601  0.50798  0.31882  0.41619
## [15]  0.34914  0.27937  0.27407  0.44326  0.10207  0.12704  0.37066
qv<-rep(NA,ncol(ptestcog) )
for ( i in 1:ncol(ptestcog) ) {
 qv[i]<-cor.test(data.matrix(ptestcog)[,i],predictedBattery[,i])$p.value
 ttl<-paste(  colnames(ptestcog)[i],
      cor(data.matrix(ptestcog)[,i],predictedBattery[,i]) )
 mdl<-data.frame( realCog=data.matrix(ptestcog)[,i],
                  predCog=predictedBattery[,i] )
 mylm<-lm( predCog ~ realCog , data=mdl )
 visreg( mylm , main=ttl)
 Sys.sleep(1)
}

plot of chunk mvarpredplot of chunk mvarpredplot of chunk mvarpredplot of chunk mvarpredplot of chunk mvarpredplot of chunk mvarpredplot of chunk mvarpredplot of chunk mvarpredplot of chunk mvarpredplot of chunk mvarpredplot of chunk mvarpredplot of chunk mvarpredplot of chunk mvarpredplot of chunk mvarpredplot of chunk mvarpredplot of chunk mvarpredplot of chunk mvarpredplot of chunk mvarpredplot of chunk mvarpredplot of chunk mvarpredplot of chunk mvarpred

qv[ is.na(qv) ]<-1
qv<-p.adjust(qv,method='BH')

The following univariate columns may be predicted using SCCAN multivariate mapping: naming_adj, semantic_adj, delay_free_adj, recog_adj, rey_recall_adj, JOLO_adj, rey_copy_adj, apathy, disinhibition, empathy.